#light


(*Multiple document support through a document graph.  This enables 
tracking references and ids among several documents.  Under this 
model, id's are supposed to be unique, but the system has to be able 
to handle non-unique ids.

The graph setup is:
Paths -> Documents
Documents -> Ids
Ids -> Objects 
Documents -> Objects 
Objects (ref->) Ids
Objects (ref->) Paths

The vertexes and edges are read-only.  The graph is where you find
methods to modify the various members.  The graph ensures
that there is only one path vertex mapped to a given path name and
that there is only one id vertex mapped to a given id within a 
given document.  

It ensures that an object vertex can only have one document, and that
an object vertex can only have one id.  Also, a document may only
have one path.  Furthermore, references must be unique meaning
the same object cannot reference another object more than once.

Edges are named based off their directions.  Thus an edge from
a path to a document is named PathDocEdge, etc.  Reference
edges are post-fixed with RefEdge.

The graph will *try* to keep documents and paths together, and it will
*try* to keep objects and ids together.

*)


module CGraph.DocumentGraph
open CGraph.Generic;
open CGraph.Generic.Algorithms;
open CGraph.DirectedGraph.Impl;
open CGraph.DirectedGraph;
open CGraph.DirectedGraph.Algorithms;
open System.Collections.Generic;
open System


type IdVertex(graph:IDirectedGraph,name:string) =
    inherit Vertex(graph)
    let mutable m_name = name
    member s.Name with get() = m_name
    
    /// Call graph.SetId( name vert), do not call this method externally
    member s.InternalSetId name = m_name <- name
    
    /// References to this id.
    member s.References 
        with get() =
            s.InternalIncoming
            |> FilterTyped(fun(edge)-> if (edge :? ObjIdRefEdge) then Some (edge.IncomingVertex :?> ObjectVertex) else None )
    
    interface INamedObject with
        member s.Name with get() = m_name
    
    member s.ObjectVertexes =
        s.InternalOutgoing
        |> Seq.filter( fun(edge)->edge :? IdObjEdge )
        |> Seq.map( fun(edge)->edge.OutgoingVertex :?> ObjectVertex )
    
    member s.PrimaryObjectVertex =
        s.ObjectVertexes
        |> Seq.first( fun vert -> Some vert )
        
        
and ObjectVertex(graph:IDirectedGraph) =
    inherit Vertex(graph) as base
    member s.Id 
        with get() =
            s.InternalIncoming
            |> Seq.first( 
                fun(vert) -> 
                    match vert with
                        | :? IdObjEdge as dedge -> 
                            Some (dedge.InternalIncoming :?> IdVertex)
                        | _ -> None )
                        
    member s.Document
        with get() =
            s.InternalIncoming
            |> Seq.first( 
                fun(vert) -> 
                    match vert with
                        | :? DocObjEdge as dedge -> 
                            Some (dedge.InternalIncoming :?> DocumentVertex)
                        | _ -> None )
                        
    /// References from this object to either an id vertex
    /// or a path vertex
    member s.References
        with get() =
            s.InternalOutgoing
            |> FilterTyped(
                fun(edge)-> if ((edge :? ObjPathRefEdge) || (edge :? ObjIdRefEdge))
                            then Some edge.OutgoingVertex else None )
                        
            
  
and DocumentVertex(graph:IDirectedGraph) =
    inherit Vertex(graph)
    
    member s.GetAllIds() =
        s.InternalOutgoing
        |> Seq.filter( fun(edge) -> edge :? DocIdEdge )
        |> Seq.map( fun(edge) -> edge.OutgoingVertex :?> IdVertex )
    
    member s.GetId name =
        s.GetAllIds()
        |> Seq.first( fun(vert) -> if vert.Name = name then Some vert else None )
        
    member s.GetAllObjects() =
        s.InternalOutgoing
        |> Seq.filter( fun(vert) -> vert :? DocObjEdge )
        |> Seq.map( fun(vert) -> vert :?> DocIdEdge )
        
    member s.GetObject name =
        match s.GetId name with
            | Some vertex -> 
                vertex.InternalOutgoing
                |> Seq.first( 
                    fun(edge) ->
                        if ( edge :? IdObjEdge )
                            then Some( edge.OutgoingVertex :?> ObjectVertex )
                            else None )
            | None -> None
        
    member s.Path 
        with get() =
            s.InternalIncoming
            |> Seq.first( 
                fun( edge ) ->
                    if ( edge :? PathDocEdge )
                        then Some (edge.IncomingVertex :?> PathVertex)
                        else None )
        
            
and PathVertex(graph:IDirectedGraph,path:string) =
    inherit Vertex(graph)
    let mutable m_path = path
    member s.Path with get() = m_path
    
    /// Call graph.SetId( name vert), do not call this method externally
    member s.InternalSetPath path = m_path <- path
    interface INamedObject with
        member s.Name with get() = m_path
        
    /// References to this document                        
    member s.References 
        with get() =
            s.InternalIncoming
            |> Seq.filter( fun(edge)-> edge :? ObjPathRefEdge )
            |> Seq.map( fun(edge) -> (edge.IncomingVertex :?> ObjectVertex ) )
        
    member s.Document
        with get() = 
            s.InternalOutgoing
            |> Seq.first( 
                fun(edge)->
                    if (edge :? PathDocEdge )
                        then Some (edge.OutgoingVertex :?> DocumentVertex)
                        else None )
    
and DocIdEdge(g:IDirectedGraph,v1:IVertex,v2:IVertex) = 
    inherit Edge(g,v1,v2)
  
and DocObjEdge(g:IDirectedGraph,v1:IVertex,v2:IVertex) =
    inherit Edge(g,v1,v2) 
    
and PathDocEdge(g:IDirectedGraph,v1:IVertex,v2:IVertex) =
    inherit Edge(g,v1,v2) 
    
and IdObjEdge(g:IDirectedGraph,v1:IVertex,v2:IVertex) =
    inherit Edge(g,v1,v2)

/// Reference from this object to that id.  Obj and id need not
/// be in the same document.  Multiple references from the same
/// object are permitted but don't make any sense.
and ObjIdRefEdge(g:IDirectedGraph,v1:IVertex,v2:IVertex) =
    inherit Edge(g,v1,v2)
    
/// Some objects will just reference other documents.
and ObjPathRefEdge(g:IDirectedGraph,v1:IVertex,v2:IVertex) =
    inherit Edge(g,v1,v2)
    
type DocumentGraph() =
    inherit DirectedGraph()
    /// Oldval, newVal, vertex applied to.
    let m_idsetFire,m_idsetEvent = IEvent.create<string*string*IdVertex>()
    let m_pathsetFire, m_pathsetEvent = IEvent.create<string*string*PathVertex>()
    
    member s.IdSetEvent = m_idsetEvent
    member s.PathSetEvent = m_pathsetEvent
                
    member s.SetId(name, (vert:IdVertex)) = 
        let oldVal = vert.Name
        vert.InternalSetId name 
        m_idsetFire(oldVal, name, vert)
    
    member s.SetPath(name, (vert:PathVertex)) = 
        let oldVal = vert.Path
        vert.InternalSetPath( name )
        m_pathsetFire( oldVal, name, vert )
    
    /// Return a unique id vertex mapped to this name or create one should
    /// one not exist.  If the name is null, or the length is zero, a new
    /// name will be generated.
    member s.GetOrCreateIdVertex ((name:string),(docVertex:DocumentVertex)) =
        let existing = docVertex.GetId name
        let name = 
            if name = null || name.Length = 0 
                then s.FindUniqueIdStr( name, docVertex )
                else name
        match existing with
            | Some vert -> vert
            | None ->
                let vert = IdVertex(s,name)
                s.AddVertex (vert :> IVertex)
                let edge = DocIdEdge(s,docVertex,vert)
                s.AddEdge edge
                vert
              
    /// This doesn't delete the id vertex, it just orphans
    /// it from the document
    member s.RemoveIdVertex (vert:IdVertex) =
        let existing = 
            vert.InternalIncoming
            |> Seq.filter( fun(edge)->edge :? DocIdEdge )
        let temp = new List<IEdge>(existing)
        temp |> Seq.iter( fun(edge)->s.RemoveEdge edge |> ignore)
                
    /// Return all of the paths in the document graph.
    member s.GetAllPaths() =
        s.Vertexes.InternalVertexes 
        |> Seq.filter(fun(vert)->vert :? PathVertex)
        |> Seq.map(fun(vert)->vert :?> PathVertex)
                
    /// Find a unique id str given this stem and this document.
    /// Should name be null or have zero length, a name will be
    /// generated.
    member s.FindUniqueIdStr ((name:string),(docVertex:DocumentVertex)) =
        let name = if name = null || name.Length = 0 then "id" else name
        docVertex.GetAllIds()
        |> Seq.map( fun( idVert) -> idVert.Name )
        |> FindUniqueStr name
    
    /// Create an id vertex with a unique id.
    member s.CreateUniqueId( name,docVertex )=
        let name = s.FindUniqueIdStr (name,docVertex)
        s.GetOrCreateIdVertex (name,docVertex)
        
    /// Find a unique path str given this stem and this ending.
    /// This simply looks internal to the document graph to find
    /// a unique path.
    member s.FindUniquePathStr(stem,ending) =
        s.GetAllPaths()
        |> Seq.map( fun( pathVert ) -> pathVert.Path )
        |> FindUniquePathStr stem ending
    
    /// Create a unique path given this stem and ending.
    /// See find unique path str
    member s.CreateUniquePath (stem,ending) =
        let name = s.FindUniquePathStr (stem,ending)
        s.GetOrCreatePathVertex name
                
    /// Get or create a path vertex given this path string.
    member s.GetOrCreatePathVertex path =
        let existing = 
            s.Vertexes.InternalVertexes
            |> Seq.first( 
                fun(vert) ->
                    match vert with
                        | :? PathVertex as pv -> if pv.Path = path then Some pv else None
                        | _ -> None )
                        
        match existing with
            | Some vert -> vert
            | None ->
                let newVert = PathVertex(s,path)
                s.AddVertex newVert
                newVert
                
    member s.GetOrCreateDocumentByPath path =
        let pathVert = s.GetOrCreatePathVertex path
        match pathVert.Document with
            | Some doc -> doc
            | None -> 
                let doc = s.CreateDocumentVertex()
                s.MapPath (pathVert,doc)
                doc
                
    member s.CreateDocumentVertex() =
        let docVert = DocumentVertex(s)
        s.AddVertex(docVert)
        docVert
   
    /// Create new object vertex
    member s.CreateObjectVertex() =
        let vert = ObjectVertex(s)
        s.AddVertex vert
        vert

    /// Return a given object based on an id vertex.
    member s.GetObjectVertexById (idvert:IdVertex) =
        idvert.InternalOutgoing
        |> Seq.first (
            fun(edge) ->
                match edge with
                    | :? IdObjEdge -> Some (edge.OutgoingVertex :?> ObjectVertex)
                    | _ -> None )
    
    /// Unmap this object from any ids
    member s.UnmapId (objVert:ObjectVertex) = 
        let existing = 
            objVert.InternalIncoming
            |> Seq.filter( fun(edge) -> edge :? IdObjEdge )
        let temp = new List<IEdge>(existing)
        temp |> Seq.iter( fun(edge)-> s.RemoveEdge edge |> ignore )
                
                
    /// Map this id to this object.
    member s.MapId ((id:IdVertex),(objVert:ObjectVertex)) =
        s.UnmapId objVert
        let newEdge = IdObjEdge(s,id,objVert)
        s.AddEdge newEdge
        
    /// Unmap this document from any paths.
    member s.UnmapPath (docVert:DocumentVertex) =
        let existing = 
            docVert.InternalIncoming
            |> Seq.filter( fun(edge) -> edge :? PathDocEdge )
        let temp = new List<IEdge>(existing)
        temp |> Seq.iter( fun(edge)-> s.RemoveEdge edge |> ignore )
        
    /// Map this path to this document.
    member s.MapPath ((path:PathVertex),docVert) =
        s.UnmapPath docVert
        let newEdge = PathDocEdge(s,path,docVert)
        s.AddEdge newEdge
    
    /// Unmap this object from any documents.
    member s.UnmapDocument (objVert:ObjectVertex) =
        let existing = 
            objVert.InternalIncoming
            |> Seq.filter( fun(edge) -> edge :? DocObjEdge )
        let temp = new List<IEdge>(existing)
        temp |> Seq.iter( fun(edge)-> s.RemoveEdge edge |> ignore )
        
    /// Map a document to a given object
    /// This is *not* the same as moving an object.
    member s.MapDocument ((docVert:DocumentVertex),objVert) =
        s.UnmapDocument objVert
        let newEdge = DocObjEdge(s,docVert,objVert)
        s.AddEdge newEdge
        
    /// Move this object to the new document.
    /// This removes old reference edges and creates new ones.
    member s.MoveObject ((objVert:ObjectVertex),newDoc) =
        let id = objVert.Id
        let oldDoc = objVert.Document
        let matching = 
            match oldDoc with
                | Some oldDoc ->
                    if ( oldDoc = newDoc ) then true else false
                | None -> false
        if (not matching)
            then
                s.UnmapDocument objVert
                s.MapDocument (newDoc,objVert)
                                                        
                match id with
                    | Some idVert ->
                        let id = s.FindUniqueIdStr (idVert.Name,newDoc)
                        s.SetId( id, idVert )
                        s.RemoveIdVertex idVert
                        let newIdDocEdge = DocIdEdge(s,newDoc,idVert)
                        s.AddEdge newIdDocEdge
                    | None -> 
                        let newId = s.CreateUniqueId ("",newDoc)
                        s.MapId (newId,objVert)
                    
    /// Move this document to a new path.  This removes reference edges
    /// and creates new ones.
    member s.MoveDocument ((docVert:DocumentVertex),(newPath:string)) =
        let path = docVert.Path
        let matching =
            match path with
                | Some pathVert -> if pathVert.Path = newPath then true else false
                | None -> false
                
        if (not matching)
            then
                match path with
                    | Some pathVert ->
                        let newPath = s.FindUniquePathStr( newPath, "" )
                        s.SetPath( newPath, pathVert )
                    | None -> 
                        let newPath = s.GetOrCreatePathVertex newPath
                        s.MapPath (newPath,docVert)
                    
    /// Dereference a given id vertex
    member s.UnrefId ((objVert:ObjectVertex),(idVert:IdVertex)) =
        let filtered = 
            objVert.InternalOutgoing
            |> Seq.first(
                fun(edge) ->
                    if ( edge :? ObjIdRefEdge )
                        then 
                            if ((edge.OutgoingVertex:?>IdVertex) = idVert) then Some edge else None
                        else None )
                        
        match filtered with
            | Some edge -> s.RemoveEdge edge |> ignore
            | None -> ()
                    
    /// Reference a given id vertex
    member s.RefId ((objVert:ObjectVertex),(idVert:IdVertex)) =
        s.UnrefId (objVert,idVert)
        let newEdge = ObjIdRefEdge(s,objVert,idVert)
        s.AddEdge newEdge
        newEdge
        
    /// Dereference a given path
    member s.UnrefPath ((objVert:ObjectVertex),(pathVert:PathVertex)) =
        let filtered = 
            objVert.InternalOutgoing
            |> Seq.first(
                fun(edge) ->
                    if ( edge :? ObjPathRefEdge )
                        then 
                            if ((edge.OutgoingVertex:?>PathVertex) = pathVert) then Some edge else None
                        else None )
                        
        match filtered with
            | Some edge -> s.RemoveEdge edge |> ignore
            | None -> ()
        
    /// Reference a given path.            
    member s.RefPath ((objVert:ObjectVertex),(pathVert:PathVertex)) =
        s.UnrefPath (objVert,pathVert)
        let newEdge = ObjPathRefEdge(s,objVert,pathVert)
        s.AddEdge newEdge
        newEdge
        